home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / src / load.c < prev    next >
C/C++ Source or Header  |  1992-11-15  |  3KB  |  140 lines
  1. #include "scheme.h"
  2.  
  3. Object V_Load_Path, V_Load_Noisilyp, V_Load_Libraries;
  4.  
  5. #ifdef CAN_LOAD_OBJ
  6. #  define Default_Load_Libraries LOAD_LIBRARIES
  7. #else
  8. #  define Default_Load_Libraries ""
  9. #endif
  10.  
  11. #if defined(CAN_DUMP) || defined(USE_LD)
  12. char Loader_Input[20];
  13. #endif
  14.  
  15. #ifdef USE_LD
  16. #  include "load.ld.c"
  17. #else
  18. #ifdef USE_RLD
  19. #  include "load.rld.c"
  20. #else
  21. #ifdef USE_SHL
  22. #  include "load.shl.c"
  23. #endif
  24. #endif
  25. #endif
  26.  
  27. Init_Load () {
  28.     Define_Variable (&V_Load_Path, "load-path",
  29.     Cons (Make_String (".", 1),
  30.     Cons (Make_String (SCM_DIR, sizeof (SCM_DIR) - 1),
  31.     Cons (Make_String (LIB_DIR, sizeof (LIB_DIR) - 1), Null))));
  32.     Define_Variable (&V_Load_Noisilyp, "load-noisily?", False);
  33.     Define_Variable (&V_Load_Libraries, "load-libraries", 
  34.     Make_String (Default_Load_Libraries, sizeof Default_Load_Libraries-1));
  35. }
  36.  
  37. Init_Loadpath (s) char *s; {     /* No GC possible here */
  38.     register char *p;
  39.     Object path = Null;
  40.  
  41.     if (s[0] == '\0')
  42.     return;
  43.     while (1) {
  44.     for (p = s; *p && *p != ','; p++)
  45.         ;
  46.     path = Cons (Make_String (s, p-s), path);
  47.     if (*p == '\0')
  48.         break;
  49.     s = ++p;
  50.     }
  51.     Var_Set (V_Load_Path, path);
  52. }
  53.  
  54. Object Is_O_File (name) Object name; {
  55.     register char *p;
  56.     register struct S_String *str;
  57.  
  58.     if (TYPE(name) == T_Symbol)
  59.     name = SYMBOL(name)->name;
  60.     str = STRING(name);
  61.     p = str->data + str->size;
  62.     return str->size >= 2 && *--p == 'o' && *--p == '.';
  63. }
  64.  
  65. void Check_Loadarg (x) Object x; {
  66.     Object tail;
  67.     register t = TYPE(x);
  68.  
  69.     if (t == T_Symbol || t == T_String)
  70.     return;
  71.     if (t != T_Pair)
  72.     Wrong_Type_Combination (x, "string, symbol, or list");
  73.     for (tail = x; !Nullp (tail); tail = Cdr (tail)) {
  74.     Object f = Car (tail);
  75.     if (TYPE(f) != T_Symbol && TYPE(f) != T_String)
  76.         Wrong_Type_Combination (f, "string or symbol");
  77.     if (!Is_O_File (f))
  78.         Primitive_Error ("~s: not an object file", f);
  79.     }
  80. }
  81.  
  82. Object General_Load (what, env) Object what, env; {
  83.     Object oldenv;
  84.     GC_Node;
  85.  
  86.     Check_Type (env, T_Environment);
  87.     oldenv = The_Environment;
  88.     GC_Link (oldenv);
  89.     Switch_Environment (env);
  90.     Check_Loadarg (what);
  91.     if (TYPE(what) == T_Pair)
  92. #ifdef CAN_LOAD_OBJ
  93.     Load_Object (what)
  94. #endif
  95.     ;
  96.     else if (Is_O_File (what))
  97. #ifdef CAN_LOAD_OBJ
  98.     Load_Object (Cons (what, Null))
  99. #endif
  100.     ;
  101.     else
  102.     Load_Source (what);
  103.     Switch_Environment (oldenv);
  104.     GC_Unlink;
  105.     return Void;
  106. }
  107.  
  108. Object P_Load (argc, argv) Object *argv; {
  109.     return General_Load (argv[0], argc == 1 ? The_Environment : argv[1]);
  110. }
  111.  
  112. Load_Source_Port (port) Object port; {
  113.     Object val;
  114.     GC_Node;
  115.  
  116.     GC_Link (port);
  117.     while (1) {
  118.     val = General_Read (port, 1);
  119.     if (TYPE(val) == T_End_Of_File)
  120.         break;
  121.     val = Eval (val);
  122.     if (Truep (Var_Get (V_Load_Noisilyp))) {
  123.         Print (val);
  124.         (void)P_Newline (0, (Object *)0);
  125.     }
  126.     }
  127.     GC_Unlink;
  128. }
  129.  
  130. Load_Source (name) Object name; {
  131.     Object port;
  132.     GC_Node;
  133.  
  134.     port = General_Open_File (name, P_INPUT, Var_Get (V_Load_Path));
  135.     GC_Link (port);
  136.     Load_Source_Port (port);
  137.     (void)P_Close_Input_Port (port);
  138.     GC_Unlink;
  139. }
  140.